home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SORTING.SWG / 0034_Classic Quicksort.pas < prev    next >
Pascal/Delphi Source File  |  1993-08-27  |  4KB  |  151 lines
  1. {
  2. > Can you show me any version of thew quick sort that you may have? I've
  3. > never seen it and never used it before. I always used an insertion sort
  4. > For anything that I was doing.
  5.  
  6. Here is one (long) non-recursive version, quite fast.
  7. }
  8.  
  9. Type
  10.   _Compare  = Function(Var A, B) : Boolean;{ QuickSort Calls This }
  11.  
  12. { --------------------------------------------------------------- }
  13. { QuickSort Algorithm by C.A.R. Hoare.  Non-Recursive adaptation  }
  14. { from "ALGORITHMS + DATA STRUCTURES = ProgramS" by Niklaus Wirth }
  15. { Prentice-Hall, 1976. Generalized For unTyped arguments.   }
  16. { --------------------------------------------------------------- }
  17.  
  18. Procedure QuickSort(V      : Pointer;   { To Array of Records }
  19.                     Cnt    : Word;      { Record Count        }
  20.                     Len    : Word;      { Record Length       }
  21.                     ALessB : _Compare); { Compare Function    }
  22.  
  23. Type
  24.   SortRec = Record
  25.     Lt, Rt : Integer
  26.   end;
  27.  
  28.   SortStak = Array [0..1] of SortRec;
  29.  
  30. Var
  31.   StkT,
  32.   StkM,
  33.   Ki, Kj,
  34.   M       : Word;
  35.   Rt, Lt,
  36.   I, J    : Integer;
  37.   Ps      : ^SortStak;
  38.   Pw, Px  : Pointer;
  39.  
  40.   Procedure Push(Left, Right : Integer);
  41.   begin
  42.     Ps^[StkT].Lt := Left;
  43.     Ps^[StkT].Rt := Right;
  44.     Inc(StkT);
  45.   end;
  46.  
  47.   Procedure Pop(Var Left, Right : Integer);
  48.   begin
  49.     Dec(StkT);
  50.     Left  := Ps^[StkT].Lt;
  51.     Right := Ps^[StkT].Rt;
  52.   end;
  53.  
  54. begin {QSort}
  55.   if (Cnt > 1) and (V <> Nil) Then
  56.   begin
  57.     StkT := Cnt - 1;    { Record Count - 1 }
  58.     Lt   := 1;          { Safety Valve    }
  59.  
  60.     { We need a stack of Log2(n-1) entries plus 1 spare For safety }
  61.  
  62.     Repeat
  63.       StkT := StkT SHR 1;
  64.       Inc(Lt);
  65.     Until StkT = 0; { 1+Log2(n-1) }
  66.  
  67.     StkM := Lt * SizeOf(SortRec) + Len + Len; { Stack Size + 2 Records }
  68.  
  69.     GetMem(Ps, StkM);   { Allocate Memory    }
  70.  
  71.     if Ps = Nil Then
  72.       RunError(215); { Catastrophic Error }
  73.  
  74.     Pw := @Ps^[Lt];   { Swap Area Pointer  }
  75.     Px := Ptr(Seg(Pw^), Ofs(Pw^) + Len); { Hold Area Pointer  }
  76.  
  77.     Lt := 0;
  78.     Rt := Cnt - 1;  { Initial Partition  }
  79.  
  80.     Push(Lt, Rt);   { Push Entire Table  }
  81.  
  82.     While StkT > 0 Do
  83.     begin  { QuickSort Main Loop }
  84.       Pop(Lt, Rt);   { Get Next Partition  }
  85.       Repeat
  86.         I := Lt; J := Rt;  { Set Work Pointers }
  87.  
  88.         { Save Record at Partition Mid-Point in Hold Area }
  89.         M := (LongInt(Lt) + Rt) div 2;
  90.         Move(Ptr(Seg(V^), Ofs(V^) + M * Len)^, Px^, Len);
  91.  
  92.         { Get Useful Offsets to speed loops }
  93.         Ki := I * Len + Ofs(V^);
  94.         Kj := J * Len + Ofs(V^);
  95.  
  96.         Repeat
  97.           { Find Left-Most Entry >= Mid-Point Entry }
  98.           While ALessB(Ptr(Seg(V^), Ki)^, Px^) Do
  99.           begin
  100.             Inc(Ki, Len);
  101.             Inc(I)
  102.           end;
  103.  
  104.           { Find Right-Most Entry <= Mid-Point Entry }
  105.           While ALessB(Px^, Ptr(Seg(V^), Kj)^) Do
  106.           begin
  107.             Dec(Kj, Len);
  108.             Dec(J)
  109.           end;
  110.  
  111.           { if I > J, the partition has been exhausted }
  112.           if I <= J Then
  113.           begin
  114.             if I < J Then  { we have two Records to exchange }
  115.             begin
  116.               Move(Ptr(Seg(V^), Ki)^, Pw^, Len);
  117.               Move(Ptr(Seg(V^), Kj)^, Ptr(Seg(V^), Ki)^, Len);
  118.               Move(Pw^, Ptr(Seg(V^), Kj)^, Len);
  119.             end;
  120.  
  121.             Inc(I);
  122.             Dec(J);
  123.             Inc(Ki, Len);
  124.             Dec(Kj, Len);
  125.           end; { if I <= J }
  126.         Until I > J;  { Until All Swaps Done }
  127.  
  128.         { We now have two partitions.  At left are all Records }
  129.         { < X, and at right are all Records > X.  The larger   }
  130.         { partition is stacked and we re-partition the residue }
  131.         { Until time to pop a deferred partition.              }
  132.  
  133.         if (J - Lt) < (Rt - I) Then { Right-Most Partition is Larger }
  134.         begin
  135.           if I < Rt Then
  136.             Push(I, Rt); { Stack Right Side }
  137.           Rt := J;    { Resume With Left }
  138.         end
  139.         else  {  Left-Most Partition is Larger }
  140.         begin
  141.           if Lt < J Then
  142.             Push(Lt, J); { Stack Left Side   }
  143.           Lt := I;    { Resume With Right }
  144.         end;
  145.  
  146.       Until Lt >= Rt;  { QuickSort is now Complete }
  147.     end;
  148.     FreeMem(Ps, StkM);   { Free Stack and Work Areas }
  149.   end;
  150. end; {QSort}
  151.